One Click 11/OneClick11.iso/Manuntencao/Reparo/SQL Server 2000 Security Tools 8/SQLCritUpdPkg_ENU.exe/SMSDeploy/sqlfix.vbs

Text File | 2003-02-07 | 13.8 KB | 405 lines

'-----------------------------------------------------------------------------------------------
' SQL Security Update
'-----------------------------------------------------------------------------------------------
'  Filename        : SQLFIX.VBS
'  Author Name    : Levi Stevens
'  Date Created    : Sunday Jan 26th, 2003
'  Version       : v1.1.021
'-----------------------------------------------------------------------------------------------
'
' Revision History:
'
'    01-26-03: Created. (levis) v1.0.011
'    01-29-03: External release (build18) added localized, pulled win9x (levis) v1.0.19
'       01-30-03: Modified.Sethu Srinivasan (SethS) v1.1.020
'                 SQLHotfixpackage executable names to SQLHotfix_{LangID}.exe
'
'       02-02-03: Modified (SethS) v1.1.021
'          Added sscheck /d /r - re-enables services
'          Added SSCHECK return value in status message
'                 Modified MIF status messages.
'-----------------------------------------------------------------------------------------------

    'Declare all global variables
    Option Explicit
    On Error Resume Next
    Dim ver : ver = "v1.1 build 021"
    Dim UserDomain, UserName, ComputerName, OutPut, logfile
    Dim Root, sTitle, windir, temp, sReturnList
    Dim i, sHeader, nResult, sLogPath, sList, sFolder, sURL

    'Declare all constants
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Const WindowsFolder = 0, SystemFolder = 1, TemporaryFolder = 2
    Const vbQuote = """", vbVariantArray = 8204, vbOffset = "    "

'-----------------------------------------------
' Initialize objects
'-----------------------------------------------

    dim wsh : set wsh = Wscript.CreateObject("Wscript.Shell")
    dim fso : set fso = Wscript.CreateObject("Scripting.FileSystemObject")
    dim net : set net = Wscript.CreateObject("Wscript.Network")
    dim arg : set arg = WScript.Arguments

'-----------------------------------------------
' Environment Settings
'-----------------------------------------------

    UserDomain = UCASE(net.UserDomain)
    UserName = UCASE(net.UserName)
    ComputerName = UCASE(net.ComputerName)

    root = Left(Wscript.ScriptFullName, InStrRev(Wscript.ScriptFullName,"\"))
    windir = wsh.ExpandEnvironmentStrings("%Windir%")
    temp = fso.GetSpecialFolder(TemporaryFolder)
    logfile = "sqlfix.log"

'-----------------------------------------------
' Check For any switches
'-----------------------------------------------
    'default boolean value
    dim bDebug : bDebug = False
    dim bSMS : bSMS = False
    dim bQFE : bQFE = False

    For i = 0 To arg.Count - 1
        Select Case LCase(arg.item(i))
            Case "/debug" : bDebug = True
            Case "/sms" : bSMS = True
            Case "/qfe" : bQFE = True
            Case "/msg" : Call DisplayMsg("msg")
            Case "/msgqfe" : Call DisplayMsg("msgqfe")
        End Select
    Next

'-----------------------------------------------
' Create log file object
'-----------------------------------------------

    Err.Clear
    sLogPath = windir & "\debug\"
    If fso.FileExists(sLogPath & logfile) Then
        set output = fso.OpenTextFile(sLogPath & logfile, ForAppending,True)
    Else
        set output = fso.CreateTextFile(sLogPath & logfile)
    End If
    If Err.Number <> 0 Then
        sLogPath = Temp & "\"
        WriteError "Failed to create log in Debug folder"
        'Not an administrator
        If fso.FileExists(sLogPath & logfile) Then
            set output = fso.OpenTextFile(sLogPath & logfile,ForAppending,True)
        Else
            set output = fso.CreateTextFile(sLogPath & logfile)
        End If
    End If

'-----------------------------------------------
' Log Header
'-----------------------------------------------

    'Write Header
    sHeader = vbCrLf & "=== SQL Fix " & ver & ";" & Now & ";" & ComputerName & ";" & _
              UserDomain & "\" & UserName & " ===" & vbCrLf
    Output.WriteLine sHeader
    Err.Clear
    WriteLog sHeader

'-----------------------------------------------
' Run SSCHECK
'-----------------------------------------------

      If Fso.FileExists(root & "sscheck.exe" ) Then
            nResult = Wsh.Run(root & "sscheck.exe /d /r ",0,True)
      Else
            nResult = 1015
      End If


    sReturnList = AddToList(sReturnList,"SSHECK(" & nResult & ")",",")
    WriteLog "SSCHECK result [" & nResult & "]"
    If Not bQFE and Not nResult = 0 Then
        'display message to user
        wsh.Run "wscript.exe " & Wscript.ScriptFullName & " /msg"
    End If

    If bQFE Then
        Select Case nResult
            Case 0 : WriteLog "Not running QFE, system is compliant"
            Case 1,2 : Call InstallQFE()
            Case Else : WriteLog "Not running QFE, error returned by SSCHECK.EXE"
        End Select
    End If

    'end the script
    Call EndScript(nResult)

'-------------------------------------------------------------------------------------------------------------------
' FUNCTIONS SECTION
'-------------------------------------------------------------------------------------------------------------------
Function InstallQFE()
    dim sInstances, sKey, sRegKey, sLangID
    dim nPatchReturn, sPatchFile, nShow
    dim bSuccess : bSuccess = False
    nPatchReturn = 255
    If bDebug Then
        nShow = 1
    Else
        nShow = 0
    End If
    'check version for all instances
    sInstances = RegRead("HKLM\Software\Microsoft\Microsoft SQL Server\InstalledInstances")
    If IsEmptyNull(sInstances) Then sInstances = Array("MSSQLSERVER")
    For Each sKey In sInstances
        WriteLog "===" & sKey & "==="
        'determine reg location for default/instances
        'HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\MSSQLServer\MSSQLServer\CurrentVersion
        If Ucase(Trim(sKey)) = "MSSQLSERVER" Then
            sRegKey = "HKLM\SOFTWARE\Microsoft\MSSQLServer\MSSQLServer\CurrentVersion\Language"
        Else
            sRegKey = "HKLM\SOFTWARE\Microsoft\Microsoft SQL Server\" & Trim(sKey) & "\MSSQLServer\CurrentVersion\Language"
        End If
        'If bDebug Then Wscript.Echo "Get LangID: " & sRegKey
        sLangID = RegRead(sRegKey)
        sList = AddToList(sList,sLangID,".")
    Next
    If Not IsEmptyNull(sList) Then
        For Each sLangID In Split(sList,".",-1,vbTextCompare)
            'install QFE
            If IsNumeric(sLangID) Then
                If bDebug Then Wscript.Echo "LangID: " & sLangID
                Select Case Cint(sLangID)
                    Case 1033 : sPatchFile = "SQLHotfix_ENU.exe"
                    Case 2052 : sPatchFile = "SQLHotfix_CHS.exe"
                    Case 1028 : sPatchFile = "SQLHotfix_CHT.exe"
                    Case 3082,1034 : sPatchFile = "SQLHotfix_ESN.exe"
                    Case 1036 : sPatchFile = "SQLHotfix_FRN.exe"
                    Case 1031 : sPatchFile = "SQLHotfix_GER.exe"
                    Case 1040 : sPatchFile = "SQLHotfix_ITA.exe"
                    Case 1041 : sPatchFile = "SQLHotfix_JPN.exe"
                    Case 1042 : sPatchFile = "SQLHotfix_KOR.exe"
                End Select
                If IsEmptyNull(sPatchFile) Then
                    bSuccess = False
                    sReturnList = AddToList(sReturnList,"SQLHotfix_" & sLangID & "(1015)",",")
                    WriteLog "Lang Unknown: " & sLangID
                Else
                    If Fso.FileExists(root & "qfe\" & sPatchFile) Then
                        nPatchReturn = Wsh.Run(root & "qfe\" & sPatchFile ,nShow,True)
                        Select Case nPatchReturn
                            Case 0, 3010 : WriteLog "Success " & sPatchFile & " result [" & nPatchReturn & "]"
                            Case Else
                                WriteLog "Failed " & sPatchFile & " result [" & nPatchReturn & "]"
                                bSuccess = False
                        End Select
                        sReturnList = AddToList(sReturnList,sPatchFile & "(" & nPatchReturn & ")",",")
                    Else
                        sReturnList = AddToList(sReturnList,sPatchFile & "(1015)",",")
                        WriteLog "File not found: " & root & "qfe\" & sPatchFile
                    End If
                End If
            End If
        Next
    End If
    'end script with return code
    If bSuccess Then
        EndScript(0)
    Else
        EndScript(nPatchReturn)
    End If
End Function

Function IsEmptyNull(sCheck)
    IsEmptyNull = False
    If IsObject(sCheck) Then Exit Function
    If IsArray(sCheck) Then Exit Function
    If VarType(sCheck) = vbEmpty Then IsEmptyNull = True : Exit Function
    If VarType(sCheck) = vbNull Then IsEmptyNull = True : Exit Function
    If sCheck = "" Then IsEmptyNull = True
End Function

Function WriteLog(sMessage)
    On Error Resume Next
    Err.Clear
    'display output to console
    If bDebug Then Wscript.Echo vbOffset & sMessage
    'write output to logfile
    sMessage = Trim(sMessage)
    If IsObject(Output) Then Output.Writeline sMessage
End Function

Function WriteError(sMessage)
    dim sErrSource, sErrDesc, sErrNum
    If Err.Number = 0 Then Exit Function
    'load error values
    sErrSource = Err.Source
    sErrDesc = Err.Description
    If IsNumeric(Err.number) Then
        sErrNum = Hex(Err.number)
    Else
        sErrNum = Err.number
    End If
    Err.Clear
    'ensure values set
    If IsEmptyNull(sErrSource) Then sErrSource = "Unknown"
    If IsEmptyNull(sErrDesc) Then sErrDesc = "No description available"
    If IsEmptyNull(sErrNum) Then sErrNum = "unknown"
    'write the mesage
    WriteLog sMessage & ": [" & sErrSource & "] " & sErrDesc & " (" & sErrNum & ")"
End Function

Sub CheckError
    If Err = 0 Then Exit Sub
    WriteLog Err.Source & ": " & Err.Description & " [" & Hex(Err) & "]"
    Err.Clear
End Sub

Function EndScript(nExitCode)
        If bSMS Then Call CreateMif(nExitCode)
        WriteLog "Exit with code [" & nExitCode & "]"
        Wscript.Quit(nExitCode)
End Function

Function AddToList(sList, sValue, sDelim)
    dim sReturn
    If IsEmptyNull(sList) Then
        sReturn = sValue
    Else
        'do not allow duplicate for string values
        If Instr(1,sList,sValue,vbTextCompare) <> 0 Then
            sReturn = sList
        Else
            sReturn = sList & sDelim & sValue
        End If
    End If
    AddToList = TrimChar(sReturn,sDelim)
End Function

Function TrimChar(sExpression,sChar)
    'trim from the right side
    Do While Lcase(Left(sExpression,1)) = Lcase(sChar)
        sExpression = Right(sExpression,Len(sExpression)-1)
    Loop
    'trim from the left side
    Do While Lcase(Right(sExpression,1)) = Lcase(sChar)
        sExpression = Left(sExpression,Len(sExpression)-1)
    Loop
    TrimChar = sExpression
End Function

'-----------------------------------------------
' Get display text
'-----------------------------------------------
Function DisplayMsg(sMode)
    dim sFile, sMsg, sLine, sIndex
    Dim oFile, oFileStream
    sFile = root & "msgbox.txt"

    'load settings from file
    If Fso.FileExists(sFile) Then
        Set oFile = Fso.GetFile(sFile)
        Set oFileStream = oFile.OpenAsTextStream(1,-2)
        If Err.number <> 0 Then Wscrip.Quit(1)
        Do While Not oFileStream.AtEndOfStream
            sLine = oFileStream.ReadLine
            If Instr(1,sLine,"=",vbTextCompare) <> 0 Then
                sIndex = Split(sLine,"=",-1,vbTextCompare)
                If bDebug Then Wscript.Echo "Index0: " & sIndex(0) & ", Index1: " & sIndex(1)
                Select Case Lcase(sIndex(0))
                    Case "url" : sURL = sIndex(1)
                    Case "title" : sTitle = sIndex(1)
                End Select
                If Not IsEmptyNull(sURL) and Not IsEmptyNull(sTitle) Then Exit Do
            End If
        Loop
    End If
    oFileStream.Close

    If IsEmpty(sURL) Then sURL = "http://msdn.microsoft.com"
    If IsEmpty(sTitle) Then sTitle = "SQL Emergency Disabler"
    If sMode = "msg" Then
        sMsg =    "Your system does not meet the minimum SQL" & vbCrLf & _
                "requirements and is at risk of the W32.Slammer virus." & vbCrLf & vbCrLf & _
                "The SQL service on this system has been terminated." & vbCrLf & _
                "Please go to " & sURL &  " for more information."
    Else
        sMsg =    "Your system does not meet the minimum SQL" & vbCrLf & _
                "requirements and is at risk of the W32.Slammer virus." & vbCrLf & vbCrLf & _
                "The SQL service has been termined and the latest QFE has been applied." & vbCrLf & _
                "Please go to " & sURL &  " for more information."
    End If
    MsgBox sMsg,vbExclamation,sTitle
    Wscript.Quit(0)
End Function

Function RegRead(sRegkey)
    RegRead = ""
    If IsEmptyNull(sRegkey) Then Exit Function
    On Error Resume Next
    Err.Clear
    dim sTemp : sTemp = wsh.RegRead(sRegkey)
    If Err.number = &H80070002 Then
        If bDebug Then Wscript.Echo vbOffset & "Key '" & sRegkey & "' does not exist"
        Err.Clear
        RegRead = ""
    Else
        If Err.number <> 0 Then
            WriteError "Error reading key " & sRegkey
        Else
            RegRead = sTemp
        End If
    End If
End Function

Sub CreateMIF(nReturn)
    dim sMIFFile : sMIFFile = "sqlfix"
    dim sMIFCompany : sMIFCompany = "System Administrator"
    dim sMIFProduct : sMIFProduct = "System Administrator"
    dim sMIFVer : sMIFVer = "1.1"
    dim sMIFDesc : sMIFDesc = CStr(nReturn) & ": Unknown Error."
    dim sMIFStatus : sMIFStatus = "0"
    dim sExec, nResult

    'get specific message
    If IsNumeric(nReturn) Then
        'general errors
        Select Case nReturn
            Case 1015 : sMIFDesc = "1015: Unable to find sscheck.exe."
            Case 1017 : sMIFDesc = "1017: Object not found."
        End Select
        'error with QFE
        If bQFE Then
            Select Case nReturn
                Case 1015 : sMIFDesc = "1015: Unable to find sscheck.exe."
                Case 1017 : sMIFDesc = "1017: Object not found."
                Case 0,3010 : sMIFDesc = nResult & ": The QFE was applied successfully"
            End Select
        Else
        'errors with SSCHECK only
            Select Case nReturn
                Case 0 : sMIFDesc = "0: No action required. No need to run the SQL Critical Update utility for this instance at this time"
                Case 1 : sMIFDesc = "1: Action recommended. Run the SQL Critical Update Utility. See readme for details"
                Case 2 : sMIFDesc = "2: Action required.  Run the SQL Critical Update Utility. See readme for details."
                Case 255: sMIFDesc = "255: There was an error and sscheck.exe failed unexpectedly."
            End Select
        End If
        'success or failure?
        Select Case nReturn
            Case 0 : sMIFStatus = "1" 'good
            Case Else : sMIFStatus = "0" 'bad
        End Select
    End If
    sMIFDesc = sMIFDesc & " " & sReturnList
    sExec = """" & root & "ISMIF32.EXE" & """" & " -f " & """" & sMIFFile & """" & _
            " -c " & """" & sMIFCompany & """" & " -p " & """" & sMIFProduct & """" & _
            " -v " & """" & sMIFVer & """" & " -d " & """" & Left(sMIFDesc,255) & """" & _
            " -s " & sMIFStatus & " -q"

    WriteLog "Create MIF: " & sExec
    If fso.FileExists(root & "ISMIF32.EXE") Then
        WriteLog "MIF Result: " & wsh.Run(sExec,0,True)
    Else
        WriteLog "MIF Result: File not found " & root & "ISMIF32.EXE"
    End If
End Sub